home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / printe1a / clsprint.cls next >
Encoding:
Visual Basic class definition  |  1997-11-20  |  10.3 KB  |  325 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "clsPrintDialog"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11. ' =======================================================================
  12. '
  13. ' CLASS   : clsPrintDialog
  14. ' PURPOSE : Show a dialog to select a printer and to set printer
  15. '           properties. Selected printer will be set to Printer object
  16. '           WITHOUT CHANGING DEFAULT PRINTER.
  17. '           Printer object could print to selected printer then.
  18. '           This class work like "MS Common Dialogs" ShowPrinter method,
  19. '           but it set Printer object without changing default printer.
  20. ' HELP    : Look "MS Common Dialogs" OCX help, it applies also to this
  21. '           class. All Flags constants are supported.
  22. ' NOTE    : Do you have found any bug or improvement ?
  23. '           Please let me know, that's why I'm sharing source code.
  24. ' AUTHOR  : ___________________________________________________
  25. '            Luca Minudel                    software designer
  26. '            Italy Conegliano(TV)
  27. '            voice & fax                     +39 (0)438 412280
  28. '            e-mail                      luca.minudel@nline.it
  29. '            WWW                       (italian language used)
  30. '            http://www.geocities.com/SiliconValley/Vista/4041
  31. '
  32. ' =======================================================================
  33. '
  34. ' --- API CONSTANTS
  35. '
  36. Private Const CCHDEVICENAME = 32
  37. Private Const CCHFORMNAME = 32
  38. Private Const GMEM_FIXED = &H0
  39. Private Const GMEM_MOVEABLE = &H2
  40. Private Const GMEM_ZEROINIT = &H40
  41. Private Const DM_DUPLEX = &H1000&
  42. Private Const DM_ORIENTATION = &H1&
  43. '
  44. ' --- API TYPES DEFINITION
  45. '
  46. Private Type PRINTDLG_TYPE
  47.   lStructSize As Long
  48.   hwndOwner As Long
  49.   hDevMode As Long
  50.   hDevNames As Long
  51.   hdc As Long
  52.   Flags As Long
  53.   nFromPage As Integer
  54.   nToPage As Integer
  55.   nMinPage As Integer
  56.   nMaxPage As Integer
  57.   nCopies As Integer
  58.   hInstance As Long
  59.   lCustData As Long
  60.   lpfnPrintHook As Long
  61.   lpfnSetupHook As Long
  62.   lpPrintTemplateName As String
  63.   lpSetupTemplateName As String
  64.   hPrintTemplate As Long
  65.   hSetupTemplate As Long
  66. End Type
  67. Private Type DEVNAMES_TYPE
  68.   wDriverOffset As Integer
  69.   wDeviceOffset As Integer
  70.   wOutputOffset As Integer
  71.   wDefault As Integer
  72.   extra As String * 100
  73. End Type
  74. Private Type DEVMODE_TYPE
  75.   dmDeviceName As String * CCHDEVICENAME
  76.   dmSpecVersion As Integer
  77.   dmDriverVersion As Integer
  78.   dmSize As Integer
  79.   dmDriverExtra As Integer
  80.   dmFields As Long
  81.   dmOrientation As Integer
  82.   dmPaperSize As Integer
  83.   dmPaperLength As Integer
  84.   dmPaperWidth As Integer
  85.   dmScale As Integer
  86.   dmCopies As Integer
  87.   dmDefaultSource As Integer
  88.   dmPrintQuality As Integer
  89.   dmColor As Integer
  90.   dmDuplex As Integer
  91.   dmYResolution As Integer
  92.   dmTTOption As Integer
  93.   dmCollate As Integer
  94.   dmFormName As String * CCHFORMNAME
  95.   dmUnusedPadding As Integer
  96.   dmBitsPerPel As Integer
  97.   dmPelsWidth As Long
  98.   dmPelsHeight As Long
  99.   dmDisplayFlags As Long
  100.   dmDisplayFrequency As Long
  101. End Type
  102. '
  103. ' --- API DECLARATIONS
  104. '
  105. Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" _
  106.                          (pPrintdlg As PRINTDLG_TYPE) As Long
  107. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
  108.                     (hpvDest As Any, _
  109.                      hpvSource As Any, _
  110.                      ByVal cbCopy As Long)
  111. Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
  112. Private Declare Function GlobalUnlock Lib "kernel32" _
  113.                          (ByVal hMem As Long) As Long
  114. Private Declare Function GlobalAlloc Lib "kernel32" _
  115.                          (ByVal wFlags As Long, _
  116.                           ByVal dwBytes As Long) As Long
  117. Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
  118. '
  119. ' --- PUBLIC ENUM
  120. '
  121. Public Enum PrinterConstants
  122.   cdlPDAllPages = &H0
  123.   cdlPDCollate = &H10
  124.   cdlPDDisablePrintToFile = &H80000
  125.   cdlPDHelpButton = &H800
  126.   cdlPDHidePrintToFile = &H100000
  127.   cdlPDNoPageNums = &H8
  128.   cdlPDNoSelection = &H4
  129.   cdlPDNoWarning = &H80
  130.   cdlPDPageNums = &H2
  131.   cdlPDPrintSetup = &H40
  132.   cdlPDPrintToFile = &H20
  133.   cdlPDReturnDC = &H100
  134.   cdlPDReturnDefault = &H400
  135.   cdlPDReturnIC = &H200
  136.   cdlPDSelection = &H1
  137.   cdlPDUseDevModeCopies = &H40000
  138. End Enum
  139. Public Enum ErrorConstants
  140.   cdlCancel = 32755
  141. End Enum
  142. '
  143. ' --- PRIVATE VARIABLES
  144. '
  145. Private intMinPage As Integer  ' Local copy of Min
  146. Private intMaxPage As Integer  ' Local copy of Max
  147. Private intFromPage As Integer ' Local copy of FromPage
  148. Private intToPage As Integer   ' Local copy of ToPage
  149. ' N.B. 0 >= Min >= FromPage >= ToPage >= Max
  150. '      If Max=0 then no limits.
  151. '
  152. ' --- PUBLIC VARIABLES
  153. '
  154. Public Flags As PrinterConstants
  155. Public CancelError As Boolean
  156. '
  157. ' -- INITIALIZE
  158. '
  159. Private Sub Class_Initialize()
  160.   intMinPage = 0
  161.   intMaxPage = 0
  162.   intFromPage = 0
  163.   intToPage = 0
  164.   CancelError = False
  165. End Sub
  166. '
  167. ' -- PUBLIC MEMBERS
  168. '
  169. Property Get Min() As Integer
  170.   Min = intMinPage
  171. End Property
  172. Property Let Min(ByVal intNewValue As Integer)
  173.   intNewValue = IIf(intNewValue > 0, intNewValue, 0)
  174.   intMinPage = intNewValue
  175.   If intNewValue > intFromPage Then _
  176.     intFromPage = intNewValue
  177.   If intNewValue > intToPage Then _
  178.     intToPage = intNewValue
  179.   If intNewValue > intMaxPage Then _
  180.     intMaxPage = intNewValue
  181. End Property
  182. Property Get FromPage() As Integer
  183.   FromPage = intFromPage
  184. End Property
  185. Property Let FromPage(ByVal intNewValue As Integer)
  186.   intNewValue = IIf(intNewValue > 0, intNewValue, 0)
  187.   intFromPage = intNewValue
  188.   If intNewValue > intToPage Then _
  189.     intToPage = intNewValue
  190.   If intNewValue > intMaxPage Then _
  191.     intMaxPage = intNewValue
  192.   If intNewValue < intMinPage Then _
  193.     intMinPage = intNewValue
  194. End Property
  195. Property Get ToPage() As Integer
  196.   ToPage = intToPage
  197. End Property
  198. Property Let ToPage(ByVal intNewValue As Integer)
  199.   intNewValue = IIf(intNewValue > 0, intNewValue, 0)
  200.   intToPage = intNewValue
  201.   If intNewValue > intMaxPage Then _
  202.     intMaxPage = intNewValue
  203.   If intNewValue < intFromPage Then _
  204.     intFromPage = intNewValue
  205.   If intNewValue < intMinPage Then _
  206.     intMinPage = intNewValue
  207. End Property
  208. Property Get Max() As Integer
  209.   Max = intMaxPage
  210. End Property
  211. Property Let Max(ByVal intNewValue As Integer)
  212.   intNewValue = IIf(intNewValue > 0, intNewValue, 0)
  213.   intMaxPage = intNewValue
  214.   If intNewValue < intToPage Then _
  215.     intToPage = intNewValue
  216.   If intNewValue < intFromPage Then _
  217.     intFromPage = intNewValue
  218.   If intNewValue < intMinPage Then _
  219.     intMinPage = intNewValue
  220. End Property
  221. Public Function ShowPrinter() As Boolean
  222. Dim PrintDlg As PRINTDLG_TYPE
  223. Dim DevMode As DEVMODE_TYPE
  224. Dim DevName As DEVNAMES_TYPE
  225. Dim lpDevMode As Long, lpDevName As Long
  226. Dim intReturn As Integer
  227. Dim objPrinter As Printer
  228. Dim strNewPrinterName As String
  229. Dim blnCancel   As Boolean
  230.   blnCancel = False
  231.   ' Use PrintDialog to get the handle to a memory
  232.   ' block with a DevMode and DevName structures
  233.   With PrintDlg
  234.     .lStructSize = Len(PrintDlg)
  235.     .hwndOwner = 0
  236.     .Flags = Flags
  237.     .nMinPage = intMinPage
  238.     .nFromPage = intFromPage
  239.     .nToPage = intToPage
  240.     .nMaxPage = intMaxPage
  241.   End With
  242.   'Set the current orientation and duplex setting
  243.   DevMode.dmDeviceName = Printer.DeviceName
  244.   DevMode.dmSize = Len(DevMode)
  245.   DevMode.dmFields = DM_ORIENTATION Or DM_DUPLEX
  246.   DevMode.dmOrientation = Printer.Orientation
  247.   On Error Resume Next
  248.   DevMode.dmDuplex = Printer.Duplex
  249.   On Error GoTo 0
  250.   'Allocate memory for the initialization hDevMode structure
  251.   'and copy the settings gathered above into this memory
  252.   PrintDlg.hDevMode = GlobalAlloc(GMEM_MOVEABLE Or _
  253.                                   GMEM_ZEROINIT, Len(DevMode))
  254.   lpDevMode = GlobalLock(PrintDlg.hDevMode)
  255.   If lpDevMode > 0 Then
  256.     CopyMemory ByVal lpDevMode, DevMode, Len(DevMode)
  257.     intReturn = GlobalUnlock(lpDevMode)
  258.   End If
  259.   'Set the current driver, device, and port name strings
  260.   With DevName
  261.     .wDriverOffset = 8
  262.     .wDeviceOffset = .wDriverOffset + 1 + Len(Printer.DriverName)
  263.     .wOutputOffset = .wDeviceOffset + 1 + Len(Printer.Port)
  264.     .wDefault = 0
  265.   End With
  266.   With Printer
  267.     DevName.extra = .DriverName & Chr(0) & _
  268.                     .DeviceName & Chr(0) & .Port & Chr(0)
  269.   End With
  270.   'Allocate memory for the initial hDevName structure
  271.   'and copy the settings gathered above into this memory
  272.   PrintDlg.hDevNames = GlobalAlloc(GMEM_MOVEABLE Or _
  273.                                    GMEM_ZEROINIT, Len(DevName))
  274.   lpDevName = GlobalLock(PrintDlg.hDevNames)
  275.   If lpDevName > 0 Then
  276.     CopyMemory ByVal lpDevName, DevName, Len(DevName)
  277.     intReturn = GlobalUnlock(lpDevName)
  278.   End If
  279.   'Call the print dialog up and let the user make changes
  280.   If PrintDialog(PrintDlg) Then
  281.     'First get the DevName structure.
  282.     lpDevName = GlobalLock(PrintDlg.hDevNames)
  283.     CopyMemory DevName, ByVal lpDevName, 45
  284.     intReturn = GlobalUnlock(lpDevName)
  285.     With PrintDlg
  286.       Flags = .Flags
  287.       intFromPage = .nFromPage
  288.       intToPage = .nToPage
  289.     End With
  290.      GlobalFree PrintDlg.hDevNames
  291.     'Next get the DevMode structure and set the printer
  292.     'properties appropriately
  293.     lpDevMode = GlobalLock(PrintDlg.hDevMode)
  294.     CopyMemory DevMode, ByVal lpDevMode, Len(DevMode)
  295.     intReturn = GlobalUnlock(PrintDlg.hDevMode)
  296.     GlobalFree PrintDlg.hDevMode
  297.     strNewPrinterName = UCase$(left(DevMode.dmDeviceName, _
  298.                         InStr(DevMode.dmDeviceName, Chr$(0)) - 1))
  299.     If Printer.DeviceName <> strNewPrinterName Then
  300.       For Each objPrinter In Printers
  301.         If UCase$(objPrinter.DeviceName) = strNewPrinterName Then _
  302.           Set Printer = objPrinter
  303.       Next
  304.     End If
  305.     On Error Resume Next
  306.     'Set printer object properties according to selections made
  307.     'by user
  308.     With Printer
  309.       .Copies = DevMode.dmCopies
  310.       .Duplex = DevMode.dmDuplex
  311.       .Orientation = DevMode.dmOrientation
  312.     End With
  313.     On Error GoTo 0
  314.   Else
  315.     GlobalFree PrintDlg.hDevMode
  316.     GlobalFree PrintDlg.hDevNames
  317.     blnCancel = True
  318.     If CancelError Then _
  319.       Err.Raise cdlCancel, "LM PrintDialog", "Cancel."
  320.   End If
  321.   ShowPrinter = Not blnCancel
  322. End Function
  323.  
  324.  
  325.